!> author: 左志华
!> date: 2022-07-16
!>
module test_sph_smoothed_kernel_function
    use testdrive, only: new_unittest, unittest_type, error_type, check
    use sph_project_type, only: project_t
    use sph_kinds, only: rk
    use sph_smoothed_kernel_function
    implicit none
    private
    public :: collect_kernel_function
contains
    !> Collect all exported unit tests
    subroutine collect_kernel_function(testsuite)
        !> Collection of tests
        type(unittest_type), allocatable, intent(out) :: testsuite(:)
        allocate (testsuite, source=[ &
                  new_unittest("FUNC: cubic_spline_kernel", test_cubic_spline_kernel), &
                  new_unittest("FUNC: quintic_spline_kernel", test_quintic_spline_kernel) &
                  ])
    end subroutine collect_kernel_function
    subroutine test_cubic_spline_kernel(error)
        type(error_type), allocatable, intent(out) :: error
        real(rk) :: w, dwdx(2)
        ! 测试距离非 0 的情况
        skf%type = 'cubic_spline'
        call skf%setup_kernel(1.0_rk)
        call skf%kernel(1.0_rk, [0.0_rk, 1.0_rk], w, dwdx)
        call check(error, w, 0.11368210220849664_rk, more="1: cubic_spline_kernel::w", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(1), 0.0_rk, more="1: cubic_spline_kernel::dwdx(1)", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(2), -0.34104630662549001_rk, more="1: cubic_spline_kernel::dwdx(2)", &
                   thr=1.0e-4_rk)
        ! 测试距离 0 的情况
        call skf%kernel(0.0_rk, [0.0_rk, 0.0_rk], w, dwdx)
        call check(error, w, 0.454728365_rk, more="2: cubic_spline_kernel::w", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, w, skf%selfden)
        if (allocated(error)) return
        call check(error, dwdx(1), 0.0_rk, more="2: cubic_spline_kernel::dwdx(1)", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(2), 0.0_rk, more="2: cubic_spline_kernel::dwdx(2)", thr=1.0e-4_rk)
    end subroutine test_cubic_spline_kernel
    subroutine test_quintic_spline_kernel(error)
        type(error_type), allocatable, intent(out) :: error
        real(rk) :: w, dwdx(2)
        ! 测试距离非 0 的情况
        skf%type = 'quintic_spline'
        call skf%setup_kernel(1.0_rk)
        call skf%kernel(1.0_rk, [0.0_rk, 1.0_rk], w, dwdx)
        call check(error, w, 0.12119748804487428_rk, more="1: quintic_spline_kernel::w", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(1), 0.0_rk, more="1: quintic_spline_kernel::dwdx(1)", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(2), -0.23307209239398899_rk, more="1: quintic_spline_kernel::dwdx(2)", &
                   thr=1.0e-4_rk)
        ! 测试距离 0 的情况
        call skf%kernel(0.0_rk, [0.0_rk, 0.0_rk], w, dwdx)
        call check(error, w, 0.30765516196006548_rk, more="2: quintic_spline_kernel::w", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, w, skf%selfden)
        if (allocated(error)) return
        call check(error, dwdx(1), 0.0_rk, more="2: quintic_spline_kernel::dwdx(1)", thr=1.0e-4_rk)
        if (allocated(error)) return
        call check(error, dwdx(2), 0.0_rk, more="2: quintic_spline_kernel::dwdx(2)", thr=1.0e-4_rk)
    end subroutine test_quintic_spline_kernel
end module test_sph_smoothed_kernel_function
